home *** CD-ROM | disk | FTP | other *** search
/ Gekikoh Dennoh Club 5 / Gekikoh Dennoh Club Vol. 5 (Japan).7z / Gekikoh Dennoh Club Vol. 5 (Japan) (Track 01).bin / docs / rakup / tree.vl < prev    next >
Encoding:
Text File  |  1998-10-03  |  2.3 KB  |  120 lines
  1. ;
  2. ; TREE.VL : ô±ò¬ÆTì⌡û╪
  3. ;
  4. ;           Copyright (C) 1998 by Makoto Hiroi
  5. ;
  6.  
  7. ;
  8. ; èiö[é╖éΘâfü[â^é╔é═üAăé╠âüâ\âbâhé≡ÆΦï`é╖éΘé▒é╞
  9. ;
  10. ; compare-object obj1 obj2  : obj1 < obj2  -> -1
  11. ;                             obj1 = obj2  ->  0
  12. ;                             obj1 > obj2  ->  1
  13. ;
  14. ; print-object obj1 : âfü[â^é╠ò\Ī
  15. ;
  16.  
  17. ;
  18. ; ô±ò¬û╪
  19. ;
  20. (defclass Tree () (root))  ; âïü[âg
  21.  
  22. ;
  23. ; É▀
  24. ;
  25. (defclass Node ()
  26.   (object         ; âfü[â^
  27.    left           ; ì╢é╠Äq
  28.    right))        ; ëEé╠Äq
  29.  
  30.  
  31. ;
  32. ; ÆTì⌡é╖éΘ
  33. ;
  34. (defmethod search-tree ((tree Tree) data)
  35.   (search-node (slot-value tree 'root) data))
  36.  
  37. ; ì─ïAö┼
  38. (defun search-node (node data)
  39.   (if node
  40.     (with-slots (object left right) node
  41.       (case (compare-object data object)
  42.         (0  t)
  43.         (1  (search-node right data))
  44.         (-1 (search-node left  data))))))
  45.  
  46.  
  47. ;
  48. ; æ}ôⁿé╖éΘ
  49. ;
  50. (defmethod insert-tree ((tree Tree) data)
  51.   (with-slots (root) tree
  52.     (setq root (insert-node root data))))
  53.  
  54.  
  55. ; ì─ïAö┼
  56. (defun insert-node (node data)
  57.   (if (null node)
  58.       (make-instance 'Node 'object data)
  59.       (with-slots (object left right) node
  60.         (case (compare-object data object)
  61.           (1  (setq right (insert-node right data)))
  62.           (-1 (setq left  (insert-node left  data))))
  63.         node)))
  64.  
  65.  
  66. ;
  67. ; ò\Īé╖éΘ
  68. ;
  69. (defmethod print-tree ((tree Tree))
  70.   (print-node (slot-value tree 'root)))
  71.  
  72. ;
  73. ; Æ╩éΦé¬é»Åçé┼Åoù═
  74. ;
  75. (defun print-node (node)
  76.   (if node
  77.     (with-slots (object left right) node
  78.       (print-node left)
  79.       (print-object object)
  80.       (print-node right))))
  81.   
  82. ; ò\Ī
  83. (defmethod print-object ((data t))
  84.   (print data))
  85.  
  86. ;
  87. ; öΣèrâüâ\âbâh
  88. ;
  89. ; ÉöÆl
  90. (defmethod compare-object ((n1 number) (n2 number))
  91.   (cond ((= n1 n2) 0)
  92.         ((< n1 n2) -1)
  93.         (t 1)))
  94.  
  95. ; ò╢ÄÜù±
  96. (defmethod compare-object ((s1 string) (s2 string))
  97.   (cond ((string= s1 s2)  0)
  98.         ((string< s1 s2) -1)
  99.         (t 1)))
  100.  
  101. ;
  102. ; âeâXâg
  103. ;
  104. ;
  105. ;(defvar *tree1* (make-instance 'Tree))
  106. ;(defvar *tree2* (make-instance 'Tree))
  107. ;
  108. ;(dotimes (x 10)
  109. ;  (insert-tree *tree1* (rand)))
  110. ;
  111. ;(print-tree *tree1*)
  112. ;
  113. ;(dolist (x '("setq" "print" "defun" "cond" "string"
  114. ;             "number" "dolist" "right" "left" "object"))
  115. ;  (insert-tree *tree2* x))
  116. ;
  117. ;(print-tree *tree2*)
  118.  
  119. ; end of file
  120.